COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	.require "lsp.pub[lsp,clt]" source
C00003 00003	.hd206 Fall 1977
C00007 00004	#. The polynomial product problem can be solved by writing two
C00010 00005	.if lines < 4 then next page
C00012 00006	#.  One way to write commons is in terms of locations.  One simply
C00024 ENDMK
C⊗;
.require "lsp.pub[lsp,clt]" source;
.LSPFONT 
.allop 
.basicops 
.MACRO  hd206 (TERM) ⊂
.BEGIN    NOFILL  TURNON "←→"
←COMPUTER SCIENCE DEPARTMENT
←STANFORD UNIVERSITY
.SKIP  
CS206  ←COMPUTING WITH SYMBOLIC EXPRESSIONS  →TERM
.TURNOFF
.END ⊃
.
.itemmac
.PORTION MAINPORTION
.PAGE ← 1
.hd206 Fall 1977
.skip
.cb Solutions to Problem Set 1.


#.  ⊗foo can be written as a single function that works in one pass;
each successive ⊗car of the list is collected on one of two spare arguments,
either the atom list or the nonatom list.  Since these lists are collected
by ⊗⊗cons⊗ing onto the front, they will be backwards.  This is cured by using
⊗reverse on both of them when the original list is exhausted.
.begin nofill


⊗⊗        foo u ← foo1[u, qNIL, qNIL]⊗

⊗⊗        foo1[u, atoms, nonatoms] ← ⊗
⊗⊗          qif qn u qthen reverse nonatoms * atoms⊗
⊗⊗          qelse qif qat qa u qthen foo1[qd u, qa u . atoms, nonatoms]⊗
⊗⊗          qelse foo1[qd u, atoms, qa u . nonatoms]⊗


$$        (DEFUN FOO (U) (FOO1 U NIL NIL)) $

$$        (DEFUN FOO1 (U ATOMS NONATOMS) $
$$               (COND ((NULL U) (REVERSE (APPEND NONATOMS ATOMS)))$
$$                     ((ATOM (CAR U))$
$$                      (FOO1 (CDR U) (CONS (CAR U) ATOMS) NONATOMS))$
$$                     (T (FOO1 (CDR U) ATOMS (CONS (CAR U) NONATOMS))))) $

.end

	⊗foo can also be written as two selection functions, one of which
collects only atoms and one which collects only nonatoms.  These functions
are similar to ⊗mapcar, but they only collect the results that pass their
test.  The selection function is ⊗selectcar.   Note
that by using  λ-notation to specifiy the function the definition of 
⊗notatm could be avoided.
.begin nofill

⊗⊗        footwo u ← selectcar[u, $$ATOM$] * selectcar[u, $$NOTATOM$]⊗

⊗⊗        selectcar[u, p] ← ⊗
⊗⊗          qif qn u qthen qNIL⊗
⊗⊗          qelse qif p qa u qthen qa u . selectcar[qd u, p]⊗
⊗⊗          qelse selectcar[qd u, p]⊗

⊗⊗        notatom u ← ¬qat u⊗


.GROUP
$$        (DEFUN FOOTWO (U) $
$$               (APPEND (SELECTCAR U 'ATOM)$
$$                       (SELECTCAR U 'NOTATOM))) $
.APART

$$        (DEFUN SELECTCAR (U P) $
$$               (COND ((NULL U) NIL)$
$$                     ((P (CAR U)) (CONS (CAR U) (SELECTCAR (CDR U) P)))$
$$                     (T (SELECTCAR (CDR U) P)))) $

$$        (DEFUN NOTATOM (U) (NOT (ATOM U))) $
.end

#. The polynomial product problem can be solved by writing two
auxiliary functions, ⊗scalprod  which multiplies a polynomial by a constant and
⊗polysum  which adds two polynomials.
.begin nofill

⊗⊗        prod[u, v] ← ⊗
⊗⊗          qif qn u qthen qNIL⊗
⊗⊗          qelse polysum[scalprod[qa u, v], 0 . prod[qd u, v]]⊗

⊗⊗        scalprod[s, l] ← ⊗
⊗⊗          qif qn l qthen qNIL qelse times[s, qa l] . scalprod[s, qd l]⊗

⊗⊗        polysum[u, v] ← ⊗
⊗⊗          qif qn u qthen v⊗
⊗⊗          qelse qif qn v qthen u⊗
⊗⊗          qelse qa u + qa v . polysum[qd u, qd v]⊗


$$        (DEFUN PROD (U V) $
$$               (COND ((NULL U) NIL)$
$$                     (T (POLYSUM (SCALPROD (CAR U) V)$
$$                                 (CONS 0. (PROD (CDR U) V)))))) $

$$        (DEFUN SCALPROD (S L) $
$$               (COND ((NULL L) NIL)$
$$                     (T (CONS (TIMES S (CAR L)) (SCALPROD S (CDR L)))))) $

$$        (DEFUN POLYSUM (U V) $
$$               (COND ((NULL U) V)$
$$                     ((NULL V) U)$
$$                     (T (CONS (PLUS (CAR U) (CAR V))$
$$                              (POLYSUM (CDR U) (CDR V)))))) $


.end
.if lines < 4 then next page;;
#.  ⊗locations can be written by using one extra variable to carry
along the path traversed so far on the search.  Whenever the current
expression matches the original expression, the path is returned as the
result of the computation.  This wins because in normal s-expressions, an
expression cannot be a subexpression of itself.  If an atom is reached 
without a match, you can safely abandon the search since that path has
failed .
.begin nofill

⊗⊗        locations[e, u] ← loc1[e, u, qNIL]⊗

⊗⊗        loc1[expr, space, path] ← ⊗
⊗⊗          qif expr = space qthen <path>⊗
⊗⊗          qelse qif qat space qthen qNIL⊗
⊗⊗          qelse loc1[expr, qa space, $$A$ . path]⊗
⊗⊗                * loc1[expr, qd space, $$D$ . path]⊗


$$        (DEFUN LOCATIONS (E U) (LOC1 E U NIL)) $

$$        (DEFUN LOC1 (EXPR SPACE PATH) $
$$               (COND ((EQUAL EXPR SPACE) (LIST PATH))$
$$                     ((ATOM SPACE) NIL)$
$$                     (T (APPEND (LOC1 EXPR (CAR SPACE) (CONS 'A PATH))$
$$                                (LOC1 EXPR$
$$                                      (CDR SPACE)$
$$                                      (CONS 'D PATH)))))) $

.end
#.  One way to write ⊗commons is in terms of ⊗locations.  One simply
collects all the subexpressions of the expression into one huge list, and
then applies ⊗locations to the ones that occur multiple times and haven't
already been done .
.begin nofill

⊗⊗        commons u ← commons1[collectsubexprs u, u, qNIL]⊗

⊗⊗        commons1[exprlist, u, results] ← ⊗
⊗⊗          qif qn exprlist qthen reverse results⊗
⊗⊗          qelse commons1[⊗
⊗⊗            qd exprlist, ⊗
⊗⊗            u, ⊗
⊗⊗            qif qa exprlist ε qd exprlist ∧ qn assoc[qa exprlist, results]⊗
⊗⊗              qthen [qa exprlist . locations[qa exprlist, u]] . results⊗
⊗⊗             qelse results]⊗

⊗⊗        collectsubexprs u ← ⊗
⊗⊗          qif qat u qthen qNIL⊗
⊗⊗          qelse qa u . collectsubexprs qa u * qd u . collectsubexprs qd u⊗


$$        (DEFUN COMMONS (U) (COMMONS1 (COLLECTSUBEXPRS U) U NIL)) $

.if lines < 4 then next page;;
$$        (DEFUN COMMONS1 (EXPRLIST U RESULTS) $
$$               (COND ((NULL EXPRLIST) (REVERSE RESULTS))$
$$        	     (T (COMMONS1 (CDR EXPRLIST)$
$$                                  U$
$$                                  (COND ((AND (MEMBER (CAR EXPRLIST)$
$$                                                      (CDR EXPRLIST))$
$$                                              (NULL (ASSOC (CAR EXPRLIST)$
$$                                                           RESULTS)))$
$$                                         (CONS (CONS (CAR EXPRLIST)$
$$                                                     (LOCATIONS (CAR EXPRLIST)$
$$                                                               U))$
$$                                               RESULTS))$
$$                                        (T RESULTS)))))) $

$$        (DEFUN COLLECTSUBEXPRS (U) $
$$               (COND ((ATOM U) NIL)$
$$                     (T (APPEND (CONS (CAR U) (COLLECTSUBEXPRS (CAR U)))$
$$                                (CONS (CDR U) (COLLECTSUBEXPRS (CDR U))))))) $

.end
	Another way to do ⊗commons is shown here as ⊗commontwo.  ⊗commall 
goes through collecting all the subexpressions and their associated
paths, then ⊗collectall gos around mashing together all the ones that
occur more than once into the appropriate format for the answer .
.begin nofill

⊗⊗        commontwo u ← cummuns[commall[u, qNIL], qNIL]⊗

⊗⊗        commall[u, path] ← ⊗
⊗⊗          qif qat u qthen <<u, path>>⊗
⊗⊗          qelse <<u, path>>⊗
⊗⊗                * commall[qa u, $$A$ . path]⊗
⊗⊗                * commall[qd u, $$D$ . path]⊗

⊗⊗        cummuns[biglist, results] ← ⊗
⊗⊗          qif qn biglist qthen results⊗
⊗⊗          qelse qif assoc[qaa biglist, results]⊗
⊗⊗                  ∨ ¬assoc[qaa biglist, qd biglist]⊗
⊗⊗            qthen cummuns[qd biglist, results]⊗
⊗⊗          qelse cummuns[⊗
⊗⊗            qd biglist, ⊗
⊗⊗            results * <qaa biglist . collectall[qaa biglist, biglist]>]⊗

⊗⊗        collectall[expr, source] ← ⊗
⊗⊗          qif qn source qthen qNIL⊗
⊗⊗          qelse qif expr = qaa source qthen ⊗
⊗⊗            qada source . collectall[expr, qd source]⊗
⊗⊗          qelse collectall[expr, qd source]⊗


.if lines < 5 then next page;;
$$        (DEFUN COMMONTWO (U) (CUMMUNS (COMMALL U NIL) NIL)) $

$$        (DEFUN COMMALL (U PATH) $
$$               (COND ((ATOM U) (LIST (LIST U PATH)))$
$$                     (T (APPEND (LIST (LIST U PATH))$
$$                                (COMMALL (CAR U) (CONS 'A PATH))$
$$                                (COMMALL (CDR U) (CONS 'D PATH)))))) $

$$        (DEFUN CUMMUNS (BIGLIST RESULTS) $
$$               (COND$
$$                ((NULL BIGLIST) RESULTS)$
$$                ((OR (ASSOC (CAAR BIGLIST) RESULTS)$
$$                     (NOT (ASSOC (CAAR BIGLIST) (CDR BIGLIST))))$
$$                 (CUMMUNS (CDR BIGLIST) RESULTS))$
$$                (T (CUMMUNS (CDR BIGLIST)$
$$                            (APPEND RESULTS$
$$                                    (LIST (CONS (CAAR BIGLIST)$
$$                                                (COLLECTALL (CAAR BIGLIST)$
$$                                                            BIGLIST)))))))) $

$$        (DEFUN COLLECTALL (EXPR SOURCE) $
$$               (COND ((NULL SOURCE) NIL)$
$$                     ((EQUAL EXPR (CAAR SOURCE))$
$$                      (CONS (CADAR SOURCE) (COLLECTALL EXPR (CDR SOURCE))))$
$$                     (T (COLLECTALL EXPR (CDR SOURCE))))) $
.end